home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / listsort.arc / LISTSORT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-08-11  |  3.8 KB  |  137 lines
  1. Program RbbsProgramListingSort (Input,Output,InFile,OutFile);
  2.  
  3.               {  LISTSORT.PAS  Version 1.0  }
  4.  
  5. {  Alphabetizes large, commented, RBBS program directories  }
  6.  
  7. Type
  8.   LineType = String[79];
  9.   FileNameType = String[12];
  10.   FileNameArrayType = Array [1..1730] of FileNameType;
  11.  
  12. Var
  13.   InFile, OutFile: Text;
  14.   InFileName, OutFileName: String[15];
  15.   Line: LineType;
  16.   FileNameArray: FileNameArrayType;
  17.   FileName: FileNameType;
  18.   Result, I, J, A, B, Index, IndexA, Count, FileLen: Integer;
  19.   Ch: Char;
  20.  
  21. Procedure Opener;
  22.   Begin
  23.     ClrScr;
  24.     WriteLn;
  25.     WriteLn ('This program was designed to sort large (500+ listings) RBBS');
  26.     WriteLn ('directories into alphabetical order by file name.');
  27.     WriteLn;
  28.     WriteLn ('Be sure you have approximately as much free disk space');
  29.     WriteLn ('as the size of the source file for output.');
  30.     WriteLn;
  31.     WriteLn;
  32.     WriteLn ('Written by:  John Tevik');
  33.     WriteLn ('             5120 Oakley');
  34.     WriteLn ('             Duluth, MN  55804');
  35.     GotoXY (1,20);
  36.     WriteLn ('Press any key to continue');
  37.     Repeat Until Keypressed;
  38.     Read (Kbd,Ch)
  39.   End;
  40.  
  41. Procedure FillArray (Var FileNameArray: FileNameArrayType; Var Count: Integer);
  42.   Var
  43.     Index: 1..12;
  44.     FileName: FileNameType;
  45.   Begin
  46.     Reset (InFile);
  47.     Count := 0;
  48.     While Not (EOF(InFile)) Do
  49.       Begin
  50.         Count := Count + 1;
  51.         ReadLn (InFile,Line);
  52.         FileName := '';
  53.         For Index := 1 To 12 Do
  54.           FileName := FileName + Line[Index];
  55.         FileNameArray[Count] := FileName
  56.       End;
  57.     Close (InFile)
  58.   End;
  59.  
  60. Procedure Swap (Var FileNameArray: FileNameArrayType; A, B: Integer);
  61.   Var
  62.     Temp: FileNameType;
  63.   Begin
  64.     Temp := FileNameArray[A];
  65.     FileNameArray[A] := FileNameArray[B];
  66.     FileNameArray[B] := Temp
  67.   End;
  68.  
  69. Begin
  70.   Opener;
  71.   ClrScr;
  72.   WriteLn ('(Drive ID not necessary if file is on default drive)');
  73.   WriteLn;
  74.   WriteLn ('Source file drive & name? ');
  75.   WriteLn ('Output file drive & name? ');
  76.   { Check that a valid source file was specIfied }
  77.   Repeat
  78.     GotoXY (27,3);
  79.     ClrEOL;
  80.     Read (InFileName);
  81.     GotoXY (1,7);
  82.     ClrEOL;
  83.     Assign (InFile,InFileName);
  84.     {$I-} Reset (InFile); {$I+}
  85.     Result := IOResult;
  86.     If Result <> 0 Then
  87.       Begin
  88.         GotoXY (1,7);
  89.         Write ('File not found!  ');
  90.         Write ('Please check disk or enter another file name.')
  91.       End;
  92.   Until Result = 0;
  93.   GotoXY (27,4);
  94.   ReadLn (OutFileName);
  95.   Assign (OutFile,OutFileName);
  96.   FillArray (FileNameArray,FileLen);
  97.   WriteLn;  WriteLn;
  98.   Write ('SortIng filenames in memory...  ');
  99.   For I := FileLen-1 DownTo 1 Do
  100.     For J := 1 To I Do
  101.       If FileNameArray[J] > FileNameArray[J+1] Then
  102.         swap (FileNameArray,J,J+1);
  103.   WriteLn ('Done');
  104.   WriteLn;
  105.   { FInd the match for FileNameArray[Index] in the source }
  106.   { file and write it into place in the target file    }
  107.   Write ('WritIng sorted data to ASCII file: ');
  108.   For Index := 1 To 15 Do
  109.     OutFileName[Index] := UpCase(OutFileName[Index]);
  110.   Write (OutFileName,'...  ');
  111.   Reset (InFile);
  112.   ReWrite (OutFile);
  113.   For Index :=  1 To FileLen Do
  114.     If Not EOF(InFile) Then
  115.       Begin
  116.         Repeat
  117.           FileName := '';
  118.           ReadLn (InFile,Line);
  119.           For IndexA := 1 To 12 Do
  120.             FileName := FileName + Line[IndexA];
  121.         Until (FileNameArray[Index] = FileName) or (EOF(InFile));
  122.         { Remove excess spaces }
  123.         Count := 79;
  124.         While (Line[Count] = ' ') or
  125.             ((Line[Count] = '0') and (Line[Count-1] = ' ')) Do
  126.           Count := Count - 1;
  127.         Delete (Line,Count+1,79-Count);
  128.         WriteLn (OutFile,Line);
  129.         Reset (InFile)
  130.       End;
  131.   Close (OutFile);
  132.   Close (InFile);
  133.   WriteLn ('Done');
  134.   GotoXY (1,18);
  135.   WriteLn ('ListSort fInished.');
  136.   GotoXY (1,23)
  137. End.